COMMENT ⊗   VALID 00017 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00003 00002	TITLE IMPTST
 00004 00003	 Cono Bits . . .
 00006 00004	 Accumulators . ..
 00007 00005	 Here is the SPW code . . .
 00008 00006	 Here is the code that sends the message to ourselves
 00009 00007	 Routine to wait for a bit
 00011 00008	 Here we decode the incoming message
 00013 00009	 Regular message
 00014 00010	 Words 2-N of regular message
 00015 00011	 Other kinds of messages
 00017 00012	 And here is the main program . . .
 00019 00013	 Here is the main loop
 00020 00014	 Operation dispach table
 00021 00015	 More error messages
 00022 00016	 More error messages
 00023 00017	 Print routines
 00024 ENDMK
⊗;
TITLE IMPTST

IMP←←400
; Cono Bits . . .

test←←100000		; Enter test mode (does anal-cranial inversion)
strin←←040000		; Start input, sets stop, clears input end
i32←←020000		; Set input byte size to 32b if IDPIEN set
o32←←010000		; Set output byte size to 32b if ODPIEN set
clrst←←004000		; Clear stop after input bit
clrwt←←002000		; Clear waiting to input bit
strout←←000200		; Start output
fino←←000100		; Finish output (last bit has been sent)
iepien←←000040		; Enable change of input end interrupt channel
idpien←←000020		; Enable change of input byte size and input done interrupt channel
odpien←←000010		; Enable change of output byte size and output done interrupt channel


; Coni bits . . .

test←←100000		; Enter test mode (does anal-cranial inversion)
imperr←←040000		; Imp error
idone←←020000		; Input done
iend←←010000		; Input end.
odone←←004000		; Output done

comment ⊗
"stop" means enable "wait".  "wait" happens after the last bit has come in
(if enabled by "stop") to allow the programmer to change input modes before the
first bit of the next word comes in.
⊗
; Accumulators . ..

t←1
t1←2
t2←3
t3←4
t4←5
t5←6
p←17

opln←←20
ipln←←20
mpln←←20

array blok[100],lostab[100],ipdl[ipln],opdl[opln],mpdl[mpln],datatab[1000]
array acs[20],detab[100]
integer nxtlnk,omode,imode,nxtlos,lstlos,nloses
integer spwdsp,idsp,ipdp,nfs,linkn,icnt,datptr,successes,sttcnt
integer a,x,nbadl,deptr,deopt,nerrs
maxlnk:	40
; Here is the SPW code . . .

spw:	cono 553
	jrst @spwdsp

donops:	move p,[iowd opln,opdl]
	cono imp,strout!strin!clrwt!idpien!odpien!iepien
	movei t,5
noplp:	datao imp,[4B7]
	pushj p,wait
	cono imp,fino
	pushj p,wait
	sojle t,tryagn
	cono imp,strout
	jrst noplp

tryagn:	move t,[13B15]
	aos t1,nxtlnk
	caml t1,maxlnk
	setz t1,
	movem t1,nxtlnk
	aosn blok(t1)
	jrst go
	movei t2,3*=60
wloop:	cono imp,strout
	datao imp,[4B7]
	pushj p,wait
	cono imp,fino
	pushj p,wait
	aosn blok(t1)
	jrst go
	sojg t2,wloop
	setom blok(t1)
	hrli t1,ltime
	pushj p,stot1
	jrst tryagn
; Here is the code that sends the message to ourselves

go:	dpb t1,[point 8,t,23]
	cono imp,strout!odpien
	datao imp,t
	pushj p,wait
	pushj p,random
	and t,[xwd 400007,0]
	tlnn t,7
	tlo t,1
	datao imp,t
	movem t,omode
	pushj p,wait
	skipge t
	cono imp,o32!odpien
	ldb t2,[point 3,t,17]
	lsh t1,3
	addi t1,datatab
rloop:	pushj p,random
	skipg omode
	andcmi t,17
	movem t,(t1)
	datao imp,t
	pushj p,wait
	addi t1,1
	sojg t2,rloop
	cono imp,fino
	pushj p,wait
	jrst tryagn
; Routine to wait for a bit

wait:	movem 17,acs+17
	movei 17,acs
	blt 17,acs+16
	movei t,wdsp
	movem t,spwdsp
	conso imp,idone!iend
dsm:	call [sixbit /DISMIS/]
	jrst ist

wdsp:	conso imp,imperr
	jrst wdsp1
	movsi t1,eb
	move p,ipdp
	pushj p,stot1
wdsp1:	conso imp,idone!iend
	jrst ocheck
ist:	coni imp,t
	datai imp,t1
	move p,ipdp
	jrst @idsp

notus:	aos nfs
ignore:	trne t,iend
	jrst se
	cono imp,clrst!clrwt
	movei t,ignore
	movem t,idsp
	jrst ocheck

clw:	cono imp,clrwt
	jrst ocheck

se:	cono imp,strin!clrwt!idpien!iepien
	movei t,first
	movem t,idsp
ocheck:	conso imp,odone
	jrst dsm
	movsi 17,acs
	blt 17,17
	popj p,
; Here we decode the incoming message

first:	ldb t3,[point 8,t1,23]		; Link # in T3
	caml t3,maxlnk
	jrst [	aos nbadl
		jrst ignore]
	ldb t4,[point 4,t1,7]
	ldb t5,[point 8,t1,15]
	cail t4,nmes
	jrst illmes
	jrst @optab(t4)

optab:	regular
	ewomi
	impgd
	blkl
	ignore
	rfnm
	ltabf
	ddead
	ewmi
	incompt
nmes←←.-optab

illmes:	movsi t1,illop
	pushj p,stot1
	jrst ignore

regular:
	caie t5,13
	jrst ignore		; Not from us, forget it
	movei t1,reg1
	movem t1,idsp
	movem t3,linkn
	skipl blok(t3)
	jrst echk
	movsi t1,moubl
	ori t1,(t3)
	pushj p,stot1
	jrst ignore

echk:	trnn t,iend
	jrst clw
mtss:	movsi t1,mts
	pushj p,stot1
	jrst ignore
; Regular message

reg1:	trne t,iend
	jrst mtss
	skipge t1
	cono imp,i32!iepien!idpien
	movem t1,imode
	cono imp,clrst!clrwt
	ldb t2,[point 3,t1,17]
	movem t2,icnt
	move t3,linkn
	lsh t3,3
	addi t3,datatab
	movem t3,datptr
	movei t1,regn
	movem t1,idsp
	jrst ocheck
; Words 2-N of regular message

regn:	sos t3,icnt
	jumpg t3,nwd
	jumpl t3,plw
	skipg imode
	ori t1,10
	jrst nwd

plw:	skipg imode
	jrst mtll
	came t1,[xwd 400000,0]
	jrst daterm
	trne t,iend
	jrst [	aos successes
		jrst se]
mtll:	movsi t1,mtl
	pushj p,stot1
	jrst ignore

daterm:	movsi t1,pberr
	or t1,linkn
	pushj p,stot1
	jrst ignore

nwd:	came t1,@datptr
	jrst nwde
	aos datptr
	jrst ocheck

nwde:	move t2,deptr
	addi t2,2
	cail t2,detab+100
	movei t2,detab
	movem t2,deptr
	movem t1,(t2)
	move t1,@datptr
	movem t1,1(t2)
	movsi t1,daterr
	or t1,linkn
	pushj p,stot1
	jrst ignore
; Other kinds of messages

ewomi:	movsi t1,ewom
	pushj p,stot1
	jrst ignore

ewmi:	skipa t1,[xwd ewm,0]
incompt:
	movsi t1,incom
	ori t1,(t3)
	pushj p,stot1
rfnm:	cain t5,13
	jrst unbl
	movsi t1,illunb
	ori t1,(t5)
	pushj p,stot1
unbl:	skipl blok(t3)
	jrst unbll
	movsi t1,unbbl
	ori t1,(t3)
	pushj p,stot1
unbll:	setom blok(t3)
	jrst ignore

ddead:	skipa t1,[xwd hdead,0]
impgd:	movsi t1,impd
	pushj p,stot1
	jrst ignore

ltabf:	skipa t1,[xwd ltabfl,0]
blkl:	movsi t1,lblock
	ori t1,(t3)
	pushj p,stot1
	jrst ignore

stot1:	aos t2,nxtlos
	aos nloses
	cail t2,lostab+100
	movei t2,lostab
	movem t2,nxtlos
	movem t1,(t2)
	popj p,
; And here is the main program . . .

START:	move p,[iowd mpln,mpdl]
	calli
	movei t,first
	movem t,idsp
	call t,[sixbit /TIMER/]
	call t1,[sixbit /DATE/]
	rot t,12
	xor t,t1
	andcm t,[1B0+3]
	addi t,1
	movem t,a
	call t1,[sixbit /MSTIME/]
	xor t,t1
	movem t,x
	setom blok
	move t,[xwd blok,blok+1]
	blt t,blok+77
	movei t,lostab
	movem t,nxtlos
	movem t,lstlos
	movei t,detab
	movem t,deptr
	movem t,deopt
	setzm nloses
	setzm nerrs
	setzm nbadl
	setzm nfs
	setzm successes
	setzm nxtlnk
	movei t,donops
	movem t,spwdsp
	move t,[iowd ipln,ipdl]
	movem t,ipdp
	movei t,=10
	movem t,sttcnt
	move 1,[xwd 400001,spw]
	call 1,[sixbit /SPCWGO/]
; Here is the main loop

loop:	movei t,1
	call t,[sixbit /SLEEP/]
	sosle sttcnt
	jrst perr
	movei t,=60
	movem t,sttcnt
	move t,successes
	pushj p,decpnt
	outstr [asciz / successful transfers
/]
	move t,nerrs
	pushj p,decpnt
	outstr [asciz / Errors
/]
perr:	skipn nloses
	jrst loop
	aos nerrs
	sos nloses
	hlrz t,@lstlos
	jrst @losops(t)
; Operation dispach table

losops:	lbl ↔ lblock←←0
	inc ↔ incom←←1
	ltf ↔ ltabfl←←2
	date ↔ daterr←←3
	ewo ↔ ewom←←4
	ew ↔ ewm←←5
	ill ↔ illop←←6
	ms ↔ mts←←7
	ml ↔ mtl←←10
	id ↔ impd←←11
	hd ↔ hdead←←12
	lt ↔ ltime←←13
	ilu ↔ illunb←←14
	pb ↔ pberr←←15
	ub ↔ unbbl←←16
	mo ↔ moubl←←17
	eb ↔ errb←←20

lbl:	outstr [asciz /Blocked link /]
plnk:	hrrz t,@lstlos
	pushj p,octpnt
docp:	pushj p,crlf
inctb:	aos t,lstlos
	cail t,lostab+100
	movei t,lostab
	movem t,lstlos
	jrst perr

inc:	outstr [asciz /Incomplete transmission /]
	jrst plnk

ltf:	outstr [asciz /Link table full
/]
	jrst inctb
; More error messages

date:	outstr [asciz /Data error /]
	hrrz t,@lstlos
	pushj p,octpnt
	pushj p,crlf
	move t4,deopt
	addi t4,2
	cail t4,detab+100
	movei t4,detab
	movem t4,deopt
	move t,(t4)
	pushj p,pow
	outstr [asciz /   /]
	move t,1(t4)
	pushj p,pow
	jrst docp

ewo:	outstr [asciz /Error without message identification
/]
	jrst inctb

ew:	outstr [asciz /Error with message identification /]
	jrst plnk

lt:	outstr [asciz /Link timed out /]
	jrst plnk

ilu:	outstr [asciz /Unblocking link of strange host /]
	jrst plnk

eb:	outstr [asciz /Error bit came up
/]
	jrst inctb
; More error messages

pb:	outstr [asciz /Padding bit error /]
	jrst plnk

ill:	outstr [asciz /Illegal opcode
/]
	jrst inctb

ms:	outstr [asciz /Message too short
/]
	jrst inctb

ml:	outstr [asciz /Message too long
/]
	jrst inctb

id:	outstr [asciz /Imp going down
/]
	jrst inctb

hd:	outstr [asciz /Host dead???
/]
	jrst inctb

ub:	outstr [asciz /Attempt to unblock an already unblocked link /]
	jrst plnk

mo:	outstr [asciz /Message on unblocked link /]
	jrst plnk
; Print routines

octpnt:	idivi t,10
	hrlm t+1,(p)
	skipe t
	pushj p,octpnt
	hlrz t,(p)
	addi t,"0"
	outchr t
	popj p,

decpnt:	idivi t,=10
	hrlm t+1,(p)
	skipe t
	pushj p,decpnt
	hlrz t,(p)
	addi t,"0"
	outchr t
	popj p,

crlf:	outstr [asciz /
/]
	popj p,

random:	move t,x
	imul t,a
	add t,[=1824726041]
	andcm t,[1B0]
	movem t,x
	popj p,

pow:	movei t5,=12
pow1:	setz t+1,
	rotc t,3
	addi t+1,"0"
	outchr t+1
	sojg t5,pow1
	popj p,

end start